(defun profundidade(tree)
;Retorna a Profundidade da arvore
  (+ 1 
    (cond
       ((null tree) -1)
       ((> (car tree) (cadddr tree)) (car tree))
       (t (cadddr tree)))))
       
(defun roda-roda(tree)
 ; Verifica a necessidade de rotacao e a executa
  (cond
    ((> (- (car tree) (cadddr tree)) 1) (trotate-r tree))
    ((< (- (car tree) (cadddr tree)) -1) (trotate-l tree))
    (T tree)))

(defun trotate-r (tree)
  ; roda uma arvore para a direita
  (destructuring-bind (nl (nll a b nrl c) m nr r) (if (< (car (cadr tree)) (cadddr (cadr tree)))
	(funcall #'(lambda (x)
  		(list (profundidade x) x (caddr tree) (cadddr tree) (car (cddddr tree))))
		(trotate-l (cadr tree)))
	tree)
    (funcall #'(lambda (x)
      	(list (profundidade a) a b (profundidade x) x))
      (list (profundidade c) c m (profundidade r) r))
  ))

(defun trotate-l (tree)
  ;roda uma arvore para a esquerda
  (destructuring-bind (nl l m nr (nlr a b nrr c)) (if (> (car (car (cddddr tree))) (cadddr (car (cddddr tree))))
  	(funcall #'(lambda (x)
		(list (car tree) (cadr tree) (caddr tree) (profundidade x) x))
		(trotate-r (car (cddddr tree))))
	tree)
    (funcall #'(lambda (x)
	  (list (profundidade x) x b (profundidade c) c))
	(list (profundidade l) l m (profundidade a) a))))

(defun avl-insert (tree dado) ;Falta ver o caso de valor igual e o de rotacionar
;insere um dado numa arvore, retorna a arvore nova
  (if (null tree) (list 0 nil dado 0 nil)
    (let* ((l (cadr tree))
     (m (caddr tree))
     (r (car (cddddr tree))))
      (cond
       ((= dado m) tree)
       ((< dado m) (funcall #'(lambda (x)
                              (roda-roda 
                                (list (profundidade x) x m (cadddr tree) r)))
                  (avl-insert l dado)))
       (t (funcall #'(lambda (x)
                              (roda-roda 
                                (list (car tree) l m (profundidade x) x)))
                  (avl-insert r dado)))
      ))))

(defun avl-remove (tree dado)
  ;remove um dado da arvore, retorna a arvore nova
  (if (null tree) nil
    (let* ((l (cadr tree))
     (m (caddr tree))
     (r (car (cddddr tree))))
      (cond 
       ((and (= m dado) (null l)) r)
       ((and (= m dado) (null r)) l)
       ((= m dado) (avl-remove (trotate-r tree) dado))
       ((< m dado) (funcall #'(lambda (x)
                              (roda-roda 
                                (list (profundidade l) l m (profundidade x) x)))
                  (avl-remove r dado)))
       ((> m dado) (funcall #'(lambda (x)
                              (roda-roda 
                                (list (profundidade x) x m (profundidade r) r)))
                  (avl-remove l dado)))
       ))
    ))

(defun treeprint (tree nivel)
  ;Imprime BEM uma arvore deitada
  (if (null tree) nil
    (progn
      (treeprint (car (cddddr tree)) (+ nivel 1))
      (dotimes (i nivel) (format t "     "))
      (format t "[~S]~%" (caddr tree))
      (treeprint (cadr tree) (+ nivel 1))
      nil
    )
    ))

(defun exl (lista)
	(if (null lista) nil
	(let ((l1 (car lista)))
	(format t "El=~A~%" l1)
	(treeprint (setf a (if (< l1 0) (avl-remove a (* -1 l1)) (avl-insert a l1))) 0)
	(exl (cdr lista))))
)